home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / rlib20.zip / RL_MULTI.PRG < prev    next >
Text File  |  1989-02-18  |  13KB  |  404 lines
  1. * Function: MULTIMENU
  2. * Author..: Richard Low
  3. * Syntax..: MULTIMENU( top, left, bottom, right, options [, columns ;
  4. *                      [, messages [, message_row [, colors ] ] ] ] )
  5. * Returns.: choice = <expN> - number of array element option picked, or
  6. *                             0 (zero) if escape was pressed
  7. * Notes...: If a parameter is not used, must pass a dummy parameter.
  8. * Where...: top      = <expN> - top row number of window
  9. *           left     = <expN> - top left corner of menu box
  10. *           bottom   =
  11. *           right    =
  12. *           options  = <expA> - array of choices
  13. *           columns  = <expN> - Optional number of columns
  14. *           messages = <expA> - Optional array of choice messages
  15. *           mess_row = <expN> - Optional row # to center messages
  16. *           colors   = <expC> - Optional ARRAY of color settings
  17.  
  18. FUNCTION MULTIMENU
  19. PARAMETERS p_top, p_left, p_bottom, p_right, p_opts, p_cols,;
  20.            p_mess, p_messrow, p_colors
  21.  
  22. *-- all parameter variables identified with 'p_'
  23. *-- all local (function) variables identified with 'f_'
  24.  
  25. PRIVATE f_mess_on, f_widest, f_incolor,  f_selected,  f_menubar, f_space,;
  26.         f_filler,  f_choice, f_firstopt, f_lastopt, f_lastrow, f_lastcol,;
  27.         f_row, f_col, f_x
  28.  
  29. *-- verify that all required parameters are the correct type
  30. IF TYPE('p_top')   + TYPE('p_left') + TYPE('p_bottom') +;
  31.    TYPE('p_right') + TYPE('p_opts') != 'NNNNA'
  32.    RETURN 0
  33. ENDIF
  34.  
  35. *-- verify the window coordinates are within bounds and in the correct order
  36. IF .NOT. ( p_top    >= 0     .AND. p_top    < 25 .AND.;
  37.            p_left   >= 0     .AND. p_left   < 80 .AND.;
  38.            p_bottom > p_top  .AND. p_bottom < 25 .AND.;
  39.            p_right  > p_left .AND. p_right  < 80 )
  40.    RETURN 0
  41. ENDIF
  42.  
  43. *-- verify there is at least 1 element in the options array
  44. IF LEN(p_opts) = 0
  45.    RETURN 0
  46. ENDIF
  47.  
  48. *-- messages displayed only if <p_mess> parmameter is an array
  49. f_mess_on = ( TYPE('p_mess') = 'A' )
  50.  
  51. *-- messages displayed on line 24 unles otherwise specified
  52. p_messrow = IF( TYPE('p_messrow') = 'N', p_messrow, 24 )
  53.  
  54.  
  55. *-- get the widest option from the array
  56. f_widest = 1
  57. FOR f_x = 1 TO LEN(p_opts)
  58.    f_widest = MAX( f_widest, LEN(p_opts[f_x]) )
  59. NEXT f_x
  60.  
  61.  
  62. *-- if # columns not specified, or skipped with wrong data type
  63. IF TYPE('p_cols') != 'N'
  64.    p_cols = 0
  65. ENDIF
  66.  
  67. *-- from above or if zero passed
  68. IF p_cols = 0
  69.    *-- use as many columns as can fit with widest option in window
  70.    p_cols = INT( (p_right - p_left + 1) / (f_widest + 1) ) + 1
  71. ENDIF
  72.  
  73.  
  74. *-- make sure the number of columns specified will fit on screen
  75. *-- allowing a minimum of 1 space between each option
  76. DO WHILE ( ( f_widest + 1 ) * p_cols ) > ( p_right - p_left + 1 )
  77.    *-- if not, trim down the number of columns (sorry!)
  78.    p_cols = p_cols - 1
  79. ENDDO
  80.  
  81.  
  82. *-- if the widest option was too wide to fit in the window, bomb out
  83. IF p_cols < 1
  84.    RETURN 0
  85. ENDIF
  86.  
  87.  
  88. *-- set up array to hold column numbers
  89. DECLARE f_column[p_cols]
  90.  
  91. *-- default minimum amount of space between column options is 1 space
  92. f_filler = 1
  93.  
  94. *-- if number of columns is more than 1, (why else would this UDF be used)
  95. *-- calculate column positions based on widest option, # columns, and window
  96. IF p_cols > 1
  97.    *-- amount of space to use for filler between columns
  98.    f_space = (p_right - p_left + 1) - (f_widest * p_cols)
  99.    *-- divvy white space up between the columns
  100.    f_filler = f_space / (p_cols - 1)
  101.    *-- make sure remainders dont screw it all up, trim down filler if needed
  102.    DO WHILE (((f_widest + f_filler) * (p_cols - 1)) + f_widest) > (p_right-p_left+1)
  103.       f_filler = f_filler - 1
  104.    ENDDO
  105.    *-- make sure it results to positive
  106.    f_filler = MAX( f_filler, 1 )
  107. ENDIF
  108.  
  109.  
  110. *-- now fill column array with column numbers, starting at left position
  111. f_column[1] = p_left
  112. FOR f_x = 2 TO p_cols
  113.    f_column[f_x] = f_column[f_x-1] + f_widest + f_filler
  114. NEXT f_x
  115.  
  116. *-- now convert filler number to spaces
  117. f_filler = IF( f_filler > 1, SPACE(f_filler), ' ' )
  118.  
  119.  
  120. *****************************************************************************
  121. **  now we are in business, having checked for most all that can go wrong  **
  122. *****************************************************************************
  123.  
  124.  
  125. *-- save incoming color
  126. STORE SETCOLOR() TO f_incolor
  127.  
  128. *-- use <color array> if it is an array AND it has at least 5 elements
  129. IF IF( TYPE('p_colors') = 'A', IF(LEN(p_colors) >= 5, .T., .F.) , .F. )
  130.    f_display  = p_colors[1]                    && display color
  131.    f_menubar  = p_colors[2]                    && menu bar color
  132.    f_selected = p_colors[5]                    && selected option color
  133. ELSE
  134.    f_display  = SETCOLOR()
  135.    f_selected = BRIGHT()
  136.    f_menubar  = GETPARM(2,f_incolor)
  137. ENDIF
  138.  
  139.  
  140. *-- first time in, start at first array element
  141. f_firstopt = 1
  142.  
  143. *-- store the last column used
  144. f_lastcol = p_cols               && maximum last column is actual last column
  145.  
  146.  
  147. *-- now display the options in the window
  148. DO f_say_opts
  149.  
  150.  
  151. DO WHILE .T.
  152.    SETCOLOR(f_menubar)
  153.    f_choice = f_element(f_row,f_col)
  154.    @ f_row,f_column[f_col] SAY p_opts[f_choice]
  155.    SETCOLOR(f_display)
  156.  
  157.    IF f_mess_on
  158.       @ p_messrow,0
  159.       @ p_messrow,(80-LEN(p_mess[f_choice]))/2 SAY p_mess[f_choice]
  160.    ENDIF
  161.    lkey = INKEY(0)
  162.  
  163.    *-- put current selection back in normal video
  164.    @ f_row,f_column[f_col] SAY p_opts[f_choice]
  165.  
  166.    DO CASE
  167.  
  168.       CASE lkey = 13
  169.          *-- Enter key
  170.          EXIT
  171.  
  172.       CASE lkey = 27
  173.          *-- Escape key
  174.          f_choice = 0
  175.          EXIT
  176.  
  177.       CASE lkey = 24 .OR. lkey = 32
  178.          *-- Down Arrow or Space Bar
  179.  
  180.          DO CASE
  181.             *-- first try same column, one row down
  182.             CASE f_element(f_row+1,f_col) <= f_lastopt
  183.                f_row = f_row + 1
  184.  
  185.             *-- next try top of next column to right
  186.             CASE f_element(p_top,f_col+1) <= f_lastopt
  187.                f_row = p_top
  188.                f_col = f_col + 1
  189.  
  190.             *-- else must be at bottom right corner, so go to beginning
  191.             OTHERWISE
  192.                f_row = p_top
  193.                f_col = 1
  194.  
  195.          ENDCASE
  196.  
  197.  
  198.       CASE lkey = 5
  199.          *-- Up Arrow
  200.  
  201.          DO CASE
  202.             *-- first try going up one row in the current column
  203.             CASE f_element(f_row-1,f_col) <= f_lastopt
  204.                f_row = f_row - 1
  205.  
  206.             *-- next try going to the bottom (last row used) of column to left
  207.             CASE f_element(f_lastrow,f_col-1) <= f_lastopt
  208.                f_row = f_lastrow
  209.                f_col = f_col - 1
  210.  
  211.             *-- after that, try one row up from last row used
  212.             CASE f_element(f_lastrow-1,f_col-1) <= f_lastopt
  213.                f_row = f_lastrow - 1
  214.                f_col = f_col - 1
  215.  
  216.             *-- then must be on first option, so try to go to end
  217.             CASE f_element(f_lastrow,f_lastcol) <= f_lastopt
  218.                f_row = f_lastrow
  219.                f_col = f_lastcol
  220.  
  221.             *-- if that didn't work, row dind't fill to end so go up 1
  222.             OTHERWISE
  223.                f_row = f_lastrow - 1
  224.                f_col = f_lastcol
  225.  
  226.          ENDCASE
  227.  
  228.  
  229.       CASE lkey = 4 .OR. lkey = 32
  230.          *-- Right Arrow or Space Bar
  231.  
  232.          DO CASE
  233.             *-- first try same row, one column over
  234.             CASE f_element(f_row,f_col+1) <= f_lastopt
  235.                f_col = f_col + 1
  236.  
  237.             *-- next try first column, one row down
  238.             CASE f_element(f_row+1,1) <= f_lastopt
  239.                f_row = f_row + 1
  240.                f_col = 1
  241.  
  242.             *-- otherwise, go to beginning (may want to disable this)
  243.             OTHERWISE
  244.                f_row = p_top
  245.                f_col = 1
  246.  
  247.          ENDCASE
  248.  
  249.  
  250.       CASE lkey = 19 .OR. lkey = 8
  251.          *-- Left Arrow or Back Space
  252.  
  253.          DO CASE
  254.             *-- first try same row, one column to the left
  255.             CASE f_element(f_row,f_col-1) <= f_lastopt
  256.                f_col = f_col - 1
  257.  
  258.             *-- next try last column, one row up
  259.             CASE f_element(f_row-1,f_lastcol) <= f_lastopt
  260.